CompactDatabase Method Example
This example uses the CompactDatabase method to change the collating order of a database. You cannot use this code in a module belonging to Northwind.mdb.
Sub CompactDatabaseX()
Dim dbsNorthwind As Database
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
' Show the properties of the original database.
With dbsNorthwind
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With
' Make sure there isn't already a file with the
' name of the compacted database.
If Dir("NwindKorean.mdb") <> "" Then _
Kill "NwindKorean.mdb"
' This statement creates a compact version of the
' Northwind database that uses a Korean language
' collating order.
DBEngine.CompactDatabase "Northwind.mdb", _
"NwindKorean.mdb", dbLangKorean
Set dbsNorthwind = OpenDatabase("NwindKorean.mdb")
' Show the properties of the compacted database.
With dbsNorthwind
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With
End Sub
This example uses the CompactDatabase method to change the version of a database. To run this code, you must have a Microsoft Jet version 1.1 database called Nwind11.mdb and you cannot use this code in a module belonging to Nwind11.mdb.
Sub CompactDatabaseX2()
Dim dbsNorthwind As Database
Dim prpLoop As Property
Set dbsNorthwind = OpenDatabase("Nwind11.mdb")
' Show the properties of the original database.
With dbsNorthwind
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With
' Make sure there isn't already a file with the
' name of the compacted database.
If Dir("Nwind20.mdb") <> "" Then _
Kill "Nwind20.mdb"
' This statement creates a compact and encrypted
' Microsoft Jet 2.0 version of a Microsoft Jet version
' 1.1 database.
DBEngine.CompactDatabase "Nwind11.mdb", _
"Nwind20.mdb", , dbEncrypt + dbVersion20
Set dbsNorthwind = OpenDatabase("Nwind20.mdb")
' Show the properties of the compacted database.
With dbsNorthwind
Debug.Print .Name & ", version " & .Version
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
.Close
End With
End Sub